home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / risc_src.lha / risc_sources / sys / tree.t < prev    next >
Encoding:
Text File  |  1989-06-30  |  3.4 KB  |  91 lines
  1. (herald tree (env tsys))
  2.  
  3. ;;; Copyright (c) 1985 Yale University
  4. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  5. ;;; This material was developed by the T Project at the Yale University Computer 
  6. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  7. ;;; and to use it for any purpose is granted, subject to the following restric-
  8. ;;; tions and understandings.
  9. ;;; 1. Any copy made of this software must include this copyright notice in full.
  10. ;;; 2. Users of this software agree to make their best efforts (a) to return
  11. ;;;    to the T Project at Yale any improvements or extensions that they make,
  12. ;;;    so that these may be included in future releases; and (b) to inform
  13. ;;;    the T Project of noteworthy uses of this software.
  14. ;;; 3. All materials developed as a consequence of the use of this software
  15. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  16. ;;;    of acknowledging credit in academic research.
  17. ;;; 4. Yale has made no warrantee or representation that the operation of
  18. ;;;    this software will be error-free, and Yale is under no obligation to
  19. ;;;    provide any services, by way of maintenance, update, or otherwise.
  20. ;;; 5. In conjunction with products arising from the use of this material,
  21. ;;;    there shall be no use of the name of the Yale University nor of any
  22. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  23. ;;;    without prior written consent from Yale in each case.
  24. ;;;
  25.  
  26. ;;;; Tree stuff.
  27.  
  28. ;++ fix for generic numbers
  29. ;++ is the microhack still needed?
  30.  
  31. (define (subst pred new old exp)
  32.   (iterate loop ((new new) (old old) (exp exp))
  33.     (cond ((eq? old exp) new)             ;++ Pessimal microhack
  34.           ((pair? exp)
  35.            (cons (loop new old (car exp))
  36.                  (loop new old (cdr exp))))
  37.           ((pred old exp) new)
  38.           (else exp))))
  39.  
  40. (define-recursive (substq new old exp)
  41.   (cond ((eq? old exp) new)             ;++ Pessimal microhack
  42.         ((pair? exp)
  43.          (cons (substq new old (car exp))
  44.                (substq new old (cdr exp))))
  45.         ((eq? old exp) new)
  46.         (else exp)))
  47.  
  48. (define-recursive (substv new old exp)
  49.   (cond ((eq? old exp) new)             ;++ Pessimal microhack
  50.         ((pair? exp)
  51.          (cons (substv new old (car exp))
  52.                (substv new old (cdr exp))))
  53.         ((equiv? old exp) new)
  54.         (else exp)))
  55.  
  56. (define-integrable (copy-tree x) (substq nil nil x))
  57.  
  58.  
  59. ;;; TREE-HASH.  Maybe this should be an operation.
  60.  
  61. (define-recursive (tree-hash tree)
  62.   (cond ((pair? tree)
  63.          (fixnum-abs
  64.           (fx+ (tree-hash (car tree))
  65.                (fixnum-ashl (tree-hash (cdr tree)) 1))))
  66.         ((symbol? tree)
  67.          (symbol-hash tree))
  68.         ((string? tree)
  69.          (string-hash tree))
  70.         ((null? tree) 31415926)
  71.         ((char? tree)
  72.          (char->ascii tree))
  73.         ((fixnum? tree)
  74.          (fixnum-abs tree))
  75.         (else (tree-hash (error "unhashable leaf~%  (~s ~s)"
  76.                                 'tree-hash
  77.                                 tree)))))
  78.  
  79.  
  80. (define (make-tree-table . maybe-id)
  81.   (create-%table (if maybe-id (car maybe-id) nil)
  82.                  0 t true tree-hash alikev?))
  83.  
  84. (define (make-tree-table-with-size start-size . maybe-id)
  85.   (create-%table (if maybe-id (car maybe-id) nil)
  86.                  start-size t true tree-hash alikev?))
  87.  
  88. (define (tree-table? x)
  89.   (and (%table? x)
  90.        (eq? (%table-hash x) tree-hash)))
  91.